home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / sptmbr11.lha / clx / sockcl.lisp < prev    next >
Lisp/Scheme  |  1992-04-27  |  5KB  |  172 lines
  1. ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
  2.  
  3. ;;;; Server Connection for kcl and ibcl
  4.  
  5. ;;; Copyright (C) 1987, 1989 Massachussetts Institute of Technology 
  6. ;;;
  7. ;;; Permission is granted to any individual or institution to use, copy,
  8. ;;; modify, and distribute this software, provided that this complete
  9. ;;; copyright and permission notice is maintained, intact, in all copies and
  10. ;;; supporting documentation.
  11. ;;;
  12. ;;; Massachussetts Institute of Technology provides this software "as is"
  13. ;;; without express or implied warranty.
  14. ;;;
  15.  
  16. ;;; Adapted from code by Roman Budzianowski - Project Athena/MIT
  17.  
  18. ;;; make-two-way-stream is probably not a reasonable thing to do.
  19. ;;; A close on a two way stream probably does not close the substreams.
  20. ;;; I presume an :io will not work (maybe because it uses 1 buffer?).
  21. ;;; There should be some fast io (writes and reads...).
  22.  
  23. ;;; Compile this file with compile-file.
  24. ;;; Load it with (si:faslink "sockcl.o" "socket.o -lc")
  25.  
  26. (in-package :xlib)
  27. #+akcl
  28. (clines "#define AKCL
  29. ")
  30. ;;; The cmpinclude.h file does not have this type definition from
  31. ;;; <kcldistribution>/h/object.h.  We include it here so the
  32. ;;; compile-file will work without figuring out where the distribution
  33. ;;; directory is located.
  34. ;;;
  35. (CLINES "
  36. enum smmode {            /*  stream mode  */
  37.     smm_input,        /*  input  */
  38.     smm_output,        /*  output  */
  39.     smm_io,            /*  input-output  */
  40.     smm_probe,        /*  probe  */
  41.     smm_synonym,        /*  synonym  */
  42.     smm_broadcast,        /*  broadcast  */
  43.     smm_concatenated,    /*  concatenated  */
  44.     smm_two_way,        /*  two way  */
  45.     smm_echo,        /*  echo  */
  46.     smm_string_input,    /*  string input  */
  47.     smm_string_output,    /*  string output  */
  48.     smm_user_defined        /*  for user defined */ 
  49. };
  50. ")
  51.  
  52. #-akcl
  53. (CLINES "
  54. struct stream {
  55.     short    t, m;
  56.     FILE    *sm_fp;        /*  file pointer  */
  57.     object    sm_object0;    /*  some object  */
  58.     object    sm_object1;    /*  some object */
  59.     int    sm_int0;    /*  some int  */
  60.     int    sm_int1;    /*  some int  */
  61.     short    sm_mode;    /*  stream mode  */
  62.                 /*  of enum smmode  */
  63. };
  64. ")
  65.  
  66.  
  67. ;;;; Connect to the server.
  68.  
  69. ;;; A lisp string is not a reasonable type for C, so copy the characters
  70. ;;; out and then call connect_to_server routine defined in socket.o
  71.  
  72. (CLINES "
  73. int
  74. konnect_to_server(host,display)
  75.      object host;        /* host name */
  76.      int    display;        /* display number */
  77. {
  78.    int fd;            /* file descriptor */
  79.    int i;
  80.    char hname[BUFSIZ];
  81.    FILE *fout, *fin;
  82.  
  83.    if (host->st.st_fillp > BUFSIZ - 1)
  84.      too_long_file_name(host);
  85.    for (i = 0;  i < host->st.st_fillp;  i++)
  86.      hname[i] = host->st.st_self[i];
  87.    hname[i] = '\\0';            /* doubled backslash for lisp */
  88.  
  89.    fd = connect_to_server(hname,display);
  90.  
  91.    return(fd);
  92. }
  93. ")
  94.  
  95. (defentry konnect-to-server (object int) (int "konnect_to_server"))
  96.  
  97.  
  98. ;;;; Make a one-way stream from a file descriptor.
  99.  
  100. (CLINES "
  101. object
  102. konnect_stream(host,fd,flag,elem)
  103.      object host;        /* not really used */
  104.      int fd;            /* file descriptor */
  105.      int flag;            /* 0 input, 1 output */
  106.      object elem;        /* 'string-char */
  107. {
  108.    struct stream *stream;
  109.    char *mode;            /* file open mode */
  110.    FILE *fp;            /* file pointer */
  111.    enum smmode smm;        /* lisp mode (a short) */
  112.    vs_mark;
  113.  
  114.    switch(flag){
  115.     case 0:
  116.       smm = smm_input;
  117.       mode = \"r\";
  118.       break;
  119.     case 1:
  120.       smm = smm_output;
  121.       mode = \"w\";
  122.       break;
  123.     default:
  124.       FEerror(\"konnect_stream : wrong mode\");
  125.    }
  126.    
  127.    fp = fdopen(fd,mode);
  128.  
  129.    if (fp == NULL) {
  130.      stream = Cnil;
  131.      vs_push(stream);
  132.    } else {
  133.      stream = alloc_object(t_stream);
  134.      stream->sm_mode = (short)smm;
  135.      stream->sm_fp = fp;
  136.      stream->sm_object0 = elem;
  137.      stream->sm_object1 = host;
  138.      stream->sm_int0 = stream->sm_int1 = 0;
  139. #ifdef AKCL
  140.      stream->sm_buffer = 0;
  141.      stream->sm_buffer = alloc_contblock(BUFSIZ);
  142.      setbuf(fp, stream->sm_buffer);
  143. #else
  144.      vs_push(stream);
  145.      setbuf(fp, alloc_contblock(BUFSIZ));
  146. #endif
  147.    }
  148.    vs_reset;
  149.    return(stream);
  150. }
  151. ")
  152.  
  153. (defentry konnect-stream (object int int object) (object "konnect_stream"))
  154.  
  155.  
  156. ;;;; Open an X stream
  157.  
  158. (defun open-socket-stream (host display)
  159.   (when (not (and (typep host    'string)    ; sanity check the arguments
  160.           (typep display 'fixnum)))
  161.     (error "Host ~s or display ~s are bad." host display))
  162.  
  163.   (let ((fd (konnect-to-server host display)))    ; get a file discriptor
  164.     (if (< fd 0)
  165.     NIL
  166.     (let ((stream-in  (konnect-stream host fd 0 'string-char))    ; input
  167.           (stream-out (konnect-stream host fd 1 'string-char)))    ; output
  168.       (if (or (null stream-in) (null stream-out))
  169.           (error "Could not make i/o streams for fd ~d." fd))
  170.       (make-two-way-stream stream-in stream-out))
  171.     )))
  172.